home *** CD-ROM | disk | FTP | other *** search
/ PCDisk Magazine Disks / PCDisk Magazine - Disk 5.img / FNPLOT.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-05-28  |  11.8 KB  |  369 lines
  1. 1  REM     FUNCTION PLOT COPYRIGHT (C) 1983 BY HUGH CALVIN
  2. 2  REM
  3. 3  REM *** FUNCTION PLOT *** IS A PORTION OF PC CUSTOM SOFTWARE'S
  4. 4  REM     GRAPHICS PACKAGE FOR THE IBM PC
  5. 5  REM
  6. 6  REM     VERSION 1.2 *** AUTHOR HUGH CALVIN *** 4/10/83
  7. 7  REM
  8. 8  REM
  9. 9  REM
  10. 10  ' ...Advanced feature...begin here with program to evaluate function coefficients
  11. 15  '
  12. 95  ' ...Advanced feature...end here with ... 95 goto 3000 ...
  13. 99  ' ...Function definitions begin on line 100
  14. 100  GOTO 1000
  15. 950  ' ...Function definitions end here
  16. 999  IF NOT CALLED% THEN 3000 ELSE CALLED%=0:RETURN
  17. 1000  IF SKIP% THEN GOTO 3000 ELSE SKIP%=-1:CLS:KEY OFF:WIDTH 80
  18. 1001  A$="This is FUNCTION PLOT, a character plotting routine for the IBM PC."
  19. 1002  B$="Version 1.2 (C) Copyright Hugh A. Calvin, 1982"
  20. 1003  LOCATE 7,7:PRINT A$
  21. 1004  LOCATE 9,17:PRINT B$
  22. 1005  FOR I=1 TO 5000:NEXT I
  23. 1006  CLS
  24. 3000  REM Function Plot routine
  25. 3005  REM
  26. 3010  ON ERROR GOTO 0:TAB$="no"
  27. 3015  CLS:A$="FUNCTION PLOT MENU":LOCATE 2:PRINT TAB(31) A$
  28. 3020  A$="Selection     Description"
  29. 3025  LOCATE 7:PRINT TAB(40-LEN(A$)/2) A$
  30. 3029  LOCATE  9,31:PRINT "1         Define function"
  31. 3030  LOCATE 10,31:PRINT "2         Plot function"
  32. 3035  LOCATE 11,31:PRINT "3         Review function"
  33. 3040  LOCATE 12,31:PRINT "4         Tabulate function"
  34. 3045  LOCATE 13,31:PRINT "5         Printer plot function"
  35. 3050  LOCATE 14,31:PRINT "6         Save function on diskette"
  36. 3055  LOCATE 15,31:PRINT "7         Enter start and stop data"
  37. 3060  LOCATE 16,31:PRINT "8         Select  plot  symbols"
  38. 3065  LOCATE 17,31:PRINT "9         Enter plot labels"
  39. 3070  LOCATE 18,31:PRINT "Esc       Return to Start"
  40. 3075  LOCATE 19,31:PRINT "X         Return to DOS"
  41. 3080  REM
  42. 3085  REM
  43. 3090  REM
  44. 3095  LOCATE 21:A$="What is your selection?":PRINT TAB(40-LEN(A$)/2) A$
  45. 3100  A$=INKEY$:IF A$="" THEN 3100
  46. 3105  IF A$=CHR$(88) OR A$=CHR$(120) THEN SYSTEM
  47. 3110  IF A$=CHR$(27) THEN 9
  48. 3115  IF LEN(A$)=1 THEN SEL1=VAL(A$) ELSE SEL1=0
  49. 3120  IF SEL1<1 OR SEL1>9 THEN FOR II%=1 TO 15:A$=INKEY$:NEXT II%:GOTO 3095
  50. 3125  CLS:ON SEL1 GOTO 3135,3285,4280,4360,3285,4310,3440,3345,3290
  51. 3130  REM
  52. 3135  CLS:A$="DEFINE FUNCTION":LOCATE 2:PRINT TAB(40-LEN(A$)/2) A$
  53. 3140  A$="Selection     Definition":LOCATE 6:PRINT TAB(40-LEN(A$)/2) A$
  54. 3145  A$="1          Type in function(s)":LOCATE 8,31:PRINT A$
  55. 3150  A$="2          Read in function(s)":LOCATE 10,31:PRINT A$
  56. 3155  A$="Esc        Return to  Menu":LOCATE 12,31:PRINT A$
  57. 3160  A$="What is your selection?":LOCATE 15:PRINT TAB(40-LEN(A$)/2) A$
  58. 3165  A$=INKEY$:IF A$="" THEN 3165
  59. 3170  IF A$=CHR$(27) THEN 3000
  60. 3175  IF LEN(A$)=1 THEN SEL3=VAL(A$) ELSE SEL3=0
  61. 3180  IF SEL3<1 OR SEL3>2 THEN 3160
  62. 3185  ON SEL3 GOTO 3195,3230
  63. 3190  REM
  64. 3195  REM  Type in function
  65. 3200  REM
  66. 3205  A$="Type your function in BASIC beginning with line 100 and ending before line 950, then PRESS F2.  Up to four functions may be entered, y1=fn1(x), y2=fn2(x), etc.
  67. 3210  CLS:PRINT A$:END
  68. 3215  REM
  69. 3220  REM Merge user file containing functions
  70. 3225  REM
  71. 3230  ON ERROR GOTO 0:CLS:PRINT "READ IN FUNCTION...";:LOCATE 4,1:GOSUB 10000
  72. 3232  INPUT "Which drive contains your function diskette ?  (a or b)  ",D$:PRINT :PRINT :PRINT :IF D$="" THEN D$="A"
  73. 3233  IF D$="a" OR D$="b" THEN 3235
  74. 3234  IF D$="A" OR D$="B" THEN 3235 ELSE 3232
  75. 3235  INPUT "What is the name of the function (.FN) file you wish to read in ? ",FILE$:IF LEN(FILE$)>7 THEN PRINT "Filename must be less than 8 characters":GOTO 3235
  76. 3250  FILSPC$=D$+":"+FILE$+".fn":RES%=1:ON ERROR GOTO 20000:OPEN "I",1,FILSPC$:CLOSE #1:ON ERROR GOTO 0
  77. 3255  CHAIN MERGE FILSPC$,10,DELETE 10-950
  78. 3260  CLS:PRINT A$:END
  79. 3265  REM
  80. 3270  REM ...Collect auxilliary information...
  81. 3275  REM
  82. 3280  REM Title,x- and y- axis label definition
  83. 3285  IF TIDEF$="yes" THEN 3330
  84. 3290  CLS:PRINT "PLOT LABEL DEFINITION";:LOCATE 2,1:GOSUB 10000
  85. 3295  INPUT "Enter plot title"; TITLE$:IF LEN(TITLE$)>60 THEN PRINT "Title must be <60 characters long":GOTO 3295
  86. 3300  INPUT "Enter y-axis label"; YLAB$:IF LEN(YLAB$)>20 THEN PRINT "Y label must be <20 characters long":GOTO 3300
  87. 3305  INPUT "Enter x-axis label"; XLAB$:IF LEN(XLAB$)>60 THEN PRINT "X label must be <60 characters long":GOTO 3305
  88. 3310  TIDEF$="yes"
  89. 3315  IF SEL1=5 THEN 3330
  90. 3320  IF SEL1<>2  THEN 3000
  91. 3325  REM
  92. 3330  REM Plot symbol definition
  93. 3335  REM
  94. 3340  IF SYMDEF$="yes" THEN 3410
  95. 3345  CLS:A$="PLOT SYMBOL DEFINITION":LOCATE 2:PRINT A$;:LOCATE 3,1:GOSUB 10000
  96. 3350  INPUT "Enter plot symbol for y1(*)",PS$:IF PS$="" THEN SYM$(0)="*":GOTO 3365
  97. 3355  IF LEN(PS$)>1 THEN PRINT "Enter 1 character":GOTO 3350
  98. 3360  SYM$(0)=PS$
  99. 3365  INPUT "Enter plot symbol for y2(x)",PS$:IF PS$="" THEN SYM$(1)="x":GOTO 3380
  100. 3370  IF LEN(PS$)>1 THEN PRINT "Enter 1 character":GOTO 3365
  101. 3375  SYM$(1)=PS$
  102. 3380  INPUT "Enter plot symbol for y3(+)",PS$:IF PS$="" THEN SYM$(2)="+":GOTO 3395
  103. 3385  IF LEN(PS$)>1 THEN PRINT "Enter 1 character":GOTO 3380
  104. 3390  SYM$(2)=PS$
  105. 3395  INPUT "Enter plot symbol for y4(#)",PS$:IF PS$="" THEN SYM$(3)="#":GOTO 3410
  106. 3400  IF LEN(PS$)>1 THEN PRINT "Enter 1 character":GOTO 3395
  107. 3405  SYM$(3)=PS$
  108. 3410  SYMDEF$="yes":IF SEL1=5 THEN 3435
  109. 3415  IF SEL1<>2 THEN 3000
  110. 3420  REM
  111. 3425  REM Start and stop definition
  112. 3430  REM
  113. 3435  IF XDEF$="yes" THEN 3765
  114. 3440  CLS:PRINT "X-AXIS DATA";:LOCATE 2,1:GOSUB 10000:INPUT "Enter start value:"; X0
  115. 3445  INPUT "Enter stop value:"; X2
  116. 3450  IF X0=>X2  THEN 3440
  117. 3455  XDEF$="yes"
  118. 3460  REM
  119. 3465  REM  Determine function minima and maxima
  120. 3470  REM
  121. 3475  FOR I=0 TO 3:MINI(I)=1E+38:MAXI(I)=-1E+38:NEXT I
  122. 3480  X3=(X2-X0)/60:R=10
  123. 3485  FOR T1=X0 TO X2+X3/2 STEP X3
  124. 3490  CALLED%=-1:X=T1:GOSUB 100
  125. 3495  IF MINI(0)>Y1 THEN MINI(0)=Y1
  126. 3500  IF MAXI(0)<Y1 THEN MAXI(0)=Y1
  127. 3505  IF MINI(1)>Y2 THEN MINI(1)=Y2
  128. 3510  IF MAXI(1)<Y2 THEN MAXI(1)=Y2
  129. 3515  IF MINI(2)>Y3 THEN MINI(2)=Y3
  130. 3520  IF MAXI(2)<Y3 THEN MAXI(2)=Y3
  131. 3525  IF MINI(3)>Y4 THEN MINI(3)=Y4
  132. 3530  IF MAXI(3)<Y4 THEN MAXI(3)=Y4
  133. 3535  NEXT T1
  134. 3540  REM
  135. 3545  REM  NFNS is the number of functions and IN is the function number if a single function is calculated...
  136. 3550  REM
  137. 3555  NFNS=0:IN=0: FOR I=0 TO 3:IF MINI(I)=MAXI(I) THEN 3570
  138. 3560  NFNS=NFNS+1
  139. 3565  IN=I
  140. 3570  NEXT I
  141. 3575  IF TAB$="yes" THEN 4415
  142. 3580  REM  establish the type of plot frame
  143. 3585  REM
  144. 3590  REM PLUMIN$ indicates whether there are plus and minus components to be plotted
  145. 3595  REM
  146. 3600  PLUMIN$="no":ALPLUS$="yes"
  147. 3605  FOR I=0 TO NFNS-1:IF MAXI(I)>0 AND MINI(I)<0 THEN PLUMIN$="yes"
  148. 3610  NEXT I
  149. 3615  REM
  150. 3620  REM if any function has components <0 then alplus$=no, ie not all of the functions are positive
  151. 3625  REM
  152. 3630  FOR I=0 TO NFNS-1:IF MINI(I)<0 THEN ALPLUS$="no"
  153. 3635  NEXT I
  154. 3640  REM
  155. 3645  REM  check to see if there are functions which are all positive and all negative
  156. 3650  REM
  157. 3655  FOR I=0 TO NFNS-1:IF MINI(I)>=0 THEN POSI$="yes"
  158. 3660  FOR J=0 TO NFNS-1:IF MAXI(J)<=0 THEN NEGI$="yes"
  159. 3665  NEXT J:IF POSI$="yes" AND NEGI$="yes" THEN PLUMIN$="yes"
  160. 3670  NEXT I
  161. 3675  REM  check to see if there are functions which are all positive and all negative
  162. 3680  REM
  163. 3685  REM choose plot frame
  164. 3690  REM
  165. 3695  IF NFNS>1 AND PLUMIN$="yes" THEN XAXIS=12:GOTO 3765
  166. 3700  IF NFNS=1 THEN 3715
  167. 3705  IF ALPLUS$="yes" THEN XAXIS=22:GOTO 3765
  168. 3710  XAXIS=2:GOTO 3765
  169. 3715  IF MAXI(IN)<=ABS(MINI(IN)) THEN 3740
  170. 3720  RATIO=ABS(MINI(IN))/MAXI(IN)
  171. 3725  IF MINI(IN)=>0 THEN XAXIS=22:GOTO 3765
  172. 3730  IF RATIO<0.34 THEN XAXIS=17:GOTO 3765
  173. 3735  XAXIS=12:GOTO 3765
  174. 3740  RAT=ABS(MAXI(IN))/ABS(MINI(IN))
  175. 3745  IF MAXI(IN)<=0 THEN XAXIS=2:GOTO 3765
  176. 3750  IF RAT<0.34 THEN XAXIS=7:GOTO 3765
  177. 3755  XAXIS=12:GOTO 3765
  178. 3760  REM
  179. 3765  IF SEL1=5 THEN 3790
  180. 3770  IF SEL1<>2 THEN 3000
  181. 3775  REM
  182. 3780  REM plot axis labels
  183. 3785  REM
  184. 3790  CLS:FOR I=1 TO 50:LOCATE 5,10:PRINT "Hit ..Esc.. to return to Menu ":NEXT I
  185. 3795  YL=LEN(YLAB$):XL=LEN(XLAB$):PL=LEN(TITLE$):CLS
  186. 3800  LOCATE 25,1:PRINT TAB(40-CINT(XL/2)) XLAB$
  187. 3805  LOCATE 1,14:PRINT TAB(40-CINT(PL/2)) TITLE$
  188. 3810  YSTART=12-CINT(YL/2)
  189. 3815  FOR I=0 TO YL-1:LOCATE I+YSTART,2:PRINT MID$(YLAB$,I+1,1):NEXT I
  190. 3820  LOCATE 1,14:PRINT TAB(40-CINT(PL/2)) TITLE$
  191. 3825  REM
  192. 3830  REM plot the axes (or frame)
  193. 3835  REM
  194. 3840  FULL$="yes"
  195. 3845  REM
  196. 3850  REM change full$ to "yes" to get a boxed in frame
  197. 3855  REM
  198. 3860  FOR I=2 TO 22:LOCATE I,10:IF((I+3) MOD 5)=0 THEN PRINT "+" ELSE PRINT "|"
  199. 3865  NEXT I
  200. 3870  FOR I=11 TO 70:LOCATE XAXIS,I:IF(I MOD 10)=0 THEN PRINT "+" ELSE PRINT "-"
  201. 3875  NEXT I
  202. 3880  IF FULL$="no" THEN 3920
  203. 3885  FOR I=2 TO 22:LOCATE I,70:IF((I+3) MOD 5)=0 THEN PRINT "+" ELSE PRINT "|"
  204. 3890  NEXT I
  205. 3895  FOR I=11 TO 70:LOCATE 2,I:IF (I MOD 10)=0 THEN PRINT "+"ELSE PRINT "-"
  206. 3900  NEXT I
  207. 3905  FOR I=11 TO 70:LOCATE 22,I:IF (I MOD 10)=0 THEN PRINT "+" ELSE PRINT "-"
  208. 3910  NEXT I
  209. 3915  REM
  210. 3920  REM
  211. 3925  REM PRINT AXIS SCALES--Y-AXIS
  212. 3930  REM
  213. 3935  IF XAXIS=22 THEN FOR I=0 TO 4:SCALEY(I)=I*0.25:NEXT I
  214. 3940  IF XAXIS=17 THEN FOR I=0 TO 4:SCALEY(I)=(I-1)/3:NEXT I
  215. 3945  IF XAXIS=12 THEN FOR I=0 TO 4:SCALEY(I)=-1+I*0.5:NEXT I
  216. 3950  IF XAXIS=7 THEN FOR I=0 TO 4:SCALEY(I)=(I-3)/3:NEXT I
  217. 3955  IF XAXIS=2 THEN FOR I=0 TO 4:SCALEY(I)=-1+I*0.25:NEXT I
  218. 3960  FOR I=0 TO 4:LOCATE I*5+2,4:PRINT USING"##.##";SCALEY(4-I):NEXT I
  219. 3965  REM
  220. 3970  REM x-axis scale
  221. 3975  REM
  222. 3977  X4=X2:IF ABS(X0)>ABS(X2) THEN X4=ABS(X0)
  223. 3980  FOR I=-6 TO 6:J=10^I
  224. 3985  IF X4/J<1 THEN 3995
  225. 3990  DEC=J
  226. 3995  NEXT I
  227. 4000  INCR=(X2-X0)/(6*DEC)
  228. 4005  FOR I=0 TO 6:LOCATE 23,6+I*10:PRINT USING"##.##";(X0/DEC)+I*INCR:NEXT I
  229. 4010  LOCATE 23,71:PRINT USING "##.#^^^^";DEC:LOCATE 23,71:PRINT "x"
  230. 4015  REM
  231. 4020  REM
  232. 4025  REM
  233. 4030  REM  define the normalization constants
  234. 4035  FOR I=0 TO 3
  235. 4040  IF MAXI(I)=MINI(I) THEN NORM(I)=1E+38:GOTO 4050
  236. 4045  IF MAXI(I)=>ABS(MINI(I)) THEN NORM(I)=MAXI(I) ELSE NORM(I)=ABS(MINI(I))
  237. 4050  NEXT I
  238. 4055  N1=NORM(0):N2=NORM(1):N3=NORM(2):N4=NORM(3)
  239. 4060  REM
  240. 4065  REM plot the normalized functions
  241. 4070  REM
  242. 4075  IF MAXI(0)=>ABS(MINI(GV)) THEN DELTAY=XAXIS-2 ELSE DELTAY=22-XAXIS
  243. 4080  K=-1:FOR I=X0 TO X2+X3/2 STEP X3:X=I:CALLED%=-1:GOSUB 100
  244. 4085  S1=Y1/N1:S2=Y2/N2:S3=Y3/N3:S4=Y4/N4
  245. 4090  K=K+1
  246. 4095  IF N1=1E+38 THEN 4110
  247. 4100  Y1PLT=CINT(XAXIS-S1*DELTAY)
  248. 4105  LOCATE Y1PLT,K+10:PRINT SYM$(0)
  249. 4110  IF N2=1E+38 THEN 4125
  250. 4115  Y2PLT=CINT(XAXIS-S2*DELTAY)
  251. 4120  LOCATE Y2PLT,K+10:PRINT SYM$(1)
  252. 4125  IF N3=1E+38 THEN 4140
  253. 4130  Y3PLT=CINT(XAXIS-S3*DELTAY)
  254. 4135  LOCATE Y3PLT,K+10:PRINT SYM$(2)
  255. 4140  IF N4=1E+38 THEN 4155
  256. 4145  Y4PLT=CINT(XAXIS-S4*DELTAY)
  257. 4150  LOCATE Y4PLT,K+10:PRINT SYM$(3)
  258. 4155  NEXT I
  259. 4160  REM
  260. 4165  REM list maxima and minima for each function
  261. 4170  REM
  262. 4175  LOCATE 2,73:PRINT "Min/Max"
  263. 4180  K=0:FOR I=0 TO NFNS-1
  264. 4185  LOCATE 4+K,74:PRINT SYM$(I)
  265. 4190  LOCATE 5+K,72:PRINT USING "#####.##";MINI(I)
  266. 4195  LOCATE 6+K,72:PRINT USING "#####.##";MAXI(I)
  267. 4200  K=K+4
  268. 4205  NEXT I
  269. 4210  REM
  270. 4215  REM ... printer plot
  271. 4220  REM
  272. 4225  IF SEL1<>5 THEN 4270
  273. 4229  ' ****following escape sequence turns on compressed character mode for an  EPSON MX printer****
  274. 4230  LPRINT CHR$(15)
  275. 4235  HOLDING.PLACE.! = 0
  276. 4240  PRINT.SCREEN = VARPTR(HOLDING.PLACE.!)
  277. 4245  POKE PRINT.SCREEN+0, 205
  278. 4250  POKE PRINT.SCREEN+1,   5
  279. 4255  POKE PRINT.SCREEN+2, 203
  280. 4260  CALL PRINT.SCREEN
  281. 4264  ' ****following escape sequence turns off compressed character mode for an EPSON MX printer****
  282. 4265  LPRINT CHR$(27) CHR$(146)
  283. 4270  A$=INKEY$:IF A$="" THEN 4270
  284. 4275  IF A$=CHR$(27) THEN 3000 ELSE 4270
  285. 4280  REM  ...review function
  286. 4285  CLS:PRINT "REVIEW FUNCTION...to continue, PRESS F2":PRINT:PRINT:PRINT
  287. 4290  LIST 100-950
  288. 4295  A$=INKEY$:IF A$="" THEN 4295
  289. 4300  IF A$=CHR$(27) THEN 3000 ELSE 4295
  290. 4305  REM
  291. 4310  REM ...save file on diskette
  292. 4312  ON ERROR GOTO 0:CLS:PRINT "SAVE FUNCTION(S)";:LOCATE 4,1:GOSUB 10000
  293. 4315  INPUT "Which drive contains your function diskette ?  (a or b)  ",D$:PRINT :PRINT :PRINT :IF D$="" THEN D$="A"
  294. 4316  IF D$="a" OR D$="b" THEN 4320
  295. 4317  IF D$="A" OR D$="B" THEN 4320 ELSE 4315
  296. 4320  INPUT "What do you want to name the file where the function(s) will be saved?",FILE$
  297. 4335  FILSPC$=D$+":"+FILE$+".fn":RES%=2:ON ERROR GOTO 20000:OPEN "O",1,FILSPC$:CLOSE #1:ON ERROR GOTO 0
  298. 4337  PRINT:PRINT:PRINT " PRESS F2 to return to the menu."
  299. 4340  LIST 10-950,FILSPC$
  300. 4345  A$=INKEY$:IF A$="" THEN 4345
  301. 4350  IF A$=CHR$(27) THEN 3000 ELSE 4345
  302. 4355  REM
  303. 4360  REM ...tabulate function(s)
  304. 4365  REM
  305. 4370  CLS:PRINT "X-AXIS DATA";:LOCATE 2,1:GOSUB 10000:INPUT "Enter start value:"; X0
  306. 4375  INPUT "Enter stop value:"; X2
  307. 4380  INPUT "Enter step size:";X4
  308. 4385  IF X0=>X2 THEN 4370
  309. 4390  IF X4=0 THEN X4=(X2-X0)/50
  310. 4395  INPUT "Enter Title Line 1: ",TI1$
  311. 4400  INPUT "Enter Title Line 2: ",TI2$
  312. 4405  PRINT : PRINT "Preparing tabulation..." :PRINT "Make sure the printer is on"
  313. 4410  R=10:TAB$="yes":GOTO 3480
  314. 4415  IF NFNS=1 THEN B$=STRING$(24,"="):C=10:GOTO 4435
  315. 4420  IF NFNS=2 THEN B$=STRING$(38,"="):C=20:GOTO 4435
  316. 4425  IF NFNS=3 THEN B$=STRING$(52,"="):C=30:GOTO 4435
  317. 4430  IF NFNS=4 THEN B$=STRING$(66,"="):C=40
  318. 4435  K=1 'k is the line counter
  319. 4440  FOR T1=X0 TO X2+X4/2 STEP X4
  320. 4445  IF K<>1 THEN 4505
  321. 4450  CKTI=0:IF (C-LEN(TI1$)/2)<0 THEN INPUT "Title Line 1 too long -- enter new title: ", TI1$: CKTI=1
  322. 4455  IF (C-LEN(TI2$)/2)<0 THEN INPUT "Title Line 2 too long -- enter new title: ",TI2$: CKTI=1
  323. 4460  IF CKTI=1 THEN GOTO 4450
  324. 4465  LPRINT CHR$(12)
  325. 4470  LPRINT:LPRINT:LPRINT TAB(C-LEN(TI1$)/2) TI1$:LPRINT TAB(C-LEN(TI2$)/2) TI2$
  326. 4475  LPRINT B$
  327. 4480  IF NFNS=1 THEN LPRINT "x","y1"
  328. 4485  IF NFNS=2 THEN LPRINT "x","y1","y2"
  329. 4490  IF NFNS=3 THEN LPRINT "x","y1","y2","y3"
  330. 4495  IF NFNS=4 THEN LPRINT "x","y1","y2","y3","y4"
  331. 4500  LPRINT B$:LPRINT
  332. 4505  CALLED%=-1:X=T1:K=K+1:GOSUB 100
  333. 4510  IF NFNS=1 THEN LPRINT USING "##.###^^^^    "; X,Y1
  334. 4515  IF NFNS=2 THEN LPRINT USING "##.###^^^^    "; X,Y1,Y2
  335. 4520  IF NFNS=3 THEN LPRINT USING "##.###^^^^    "; X,Y1,Y2,Y3
  336. 4525  IF NFNS=4 THEN LPRINT USING "##.###^^^^    "; X,Y1,Y2,Y3,Y4
  337. 4530  IF K<52 THEN 4545
  338. 4535  LPRINT CHR$(12)
  339. 4540  K=1
  340. 4545  NEXT T1
  341. 4550  PRINT "TABULATION COMPLETE...hit Esc to return to menu"
  342. 4555  A$=INKEY$:IF A$="" THEN 4555
  343. 4560  IF A$=CHR$(27) THEN R=0:GOTO 3000
  344. 4561  GOTO 4555
  345. 4565  END
  346. 10000  YY%=CSRLIN
  347. 10010  PRINT "Press <Esc> to return to Main Menu or <Return> to continue... ";
  348. 10020  A$=INKEY$:IF A$="" THEN 10020
  349. 10030  IF A$=CHR$(27) THEN PRINT "Esc";:RETURN 3000
  350. 10040  IF A$=CHR$(13) THEN LOCATE YY%,1:PRINT STRING$(79," ");:LOCATE YY%,1:GOTO 10099
  351. 10050  BEEP:FOR II%=1 TO 15:A$=INKEY$:NEXT II%:GOTO 10020
  352. 10099  RETURN
  353. 20000  'ERROR TRAP FOR DISK READS AND WRITES
  354. 20010  IF ERR=53 THEN MSG$="File not found":GOTO 20100
  355. 20020  IF ERR=61 THEN MSG$="Disk full":GOTO 20100
  356. 20030  IF ERR=67 THEN MSG$="Too many files":GOTO 20100
  357. 20040  IF ERR=68 THEN MSG$="Device Unavailable":GOTO 20100
  358. 20050  IF ERR=70 THEN MSG$="Disk Write Protect":GOTO 20100
  359. 20060  IF ERR=71 THEN MSG$="Disk not Ready":GOTO 20100
  360. 20070  IF ERR=72 THEN MSG$="Disk Media":GOTO 20100
  361. 20080  LOCATE 23,1:PRINT "Error #";ERR;" has occurred in line";ERL;" -- Returning to Basic.";:END
  362. 20100  LOCATE 23,1:PRINT "A ";MSG$;" has occurred."
  363. 20110  PRINT "Press <Return> to try again or <Esc> to return to Main Menu";
  364. 20120  A$=INKEY$:IF A$="" THEN 20120
  365. 20130  IF A$=CHR$(27) THEN RESUME 3000
  366. 20140  IF A$=CHR$(13) THEN 20200
  367. 20150  BEEP:FOR II%=1 TO 15:A$=INKEY$:NEXT II%:GOTO 20120
  368. 20200  IF RES%=1 THEN RESUME 3230 ELSE RESUME 4312
  369.